home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / choosedir.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  9.5 KB  |  311 lines
  1. # choosedir.tcl --
  2. #
  3. #    Choose directory dialog implementation for Unix/Mac.
  4. #
  5. # Copyright (c) 1998-2000 by Scriptics Corporation.
  6. # All rights reserved.
  7. # 
  8. # RCS: @(#) $Id: choosedir.tcl,v 1.23 2007/12/13 15:26:27 dgp Exp $
  9.  
  10. # Make sure the tk::dialog namespace, in which all dialogs should live, exists
  11. namespace eval ::tk::dialog {}
  12. namespace eval ::tk::dialog::file {}
  13.  
  14. # Make the chooseDir namespace inside the dialog namespace
  15. namespace eval ::tk::dialog::file::chooseDir {
  16.     namespace import -force ::tk::msgcat::*
  17. }
  18.  
  19. # ::tk::dialog::file::chooseDir:: --
  20. #
  21. #    Implements the TK directory selection dialog.
  22. #
  23. # Arguments:
  24. #    args        Options parsed by the procedure.
  25. #
  26. proc ::tk::dialog::file::chooseDir:: {args} {
  27.     variable ::tk::Priv
  28.     set dataName __tk_choosedir
  29.     upvar ::tk::dialog::file::$dataName data
  30.     Config $dataName $args
  31.  
  32.     if {$data(-parent) eq "."} {
  33.         set w .$dataName
  34.     } else {
  35.         set w $data(-parent).$dataName
  36.     }
  37.  
  38.     # (re)create the dialog box if necessary
  39.     #
  40.     if {![winfo exists $w]} {
  41.     ::tk::dialog::file::Create $w TkChooseDir
  42.     } elseif {[winfo class $w] ne "TkChooseDir"} {
  43.     destroy $w
  44.     ::tk::dialog::file::Create $w TkChooseDir
  45.     } else {
  46.     set data(dirMenuBtn) $w.contents.f1.menu
  47.     set data(dirMenu) $w.contents.f1.menu.menu
  48.     set data(upBtn) $w.contents.f1.up
  49.     set data(icons) $w.contents.icons
  50.     set data(ent) $w.contents.f2.ent
  51.     set data(okBtn) $w.contents.f2.ok
  52.     set data(cancelBtn) $w.contents.f2.cancel
  53.     set data(hiddenBtn) $w.contents.f2.hidden
  54.     }
  55.     if {$::tk::dialog::file::showHiddenBtn} {
  56.     $data(hiddenBtn) configure -state normal
  57.     grid $data(hiddenBtn)
  58.     } else {
  59.     $data(hiddenBtn) configure -state disabled
  60.     grid remove $data(hiddenBtn)
  61.     }
  62.  
  63.     # When using -mustexist, manage the OK button state for validity
  64.     $data(okBtn) configure -state normal
  65.     if {$data(-mustexist)} {
  66.     $data(ent) configure -validate key \
  67.         -validatecommand [list ::tk::dialog::file::chooseDir::IsOK? $w %P]
  68.     } else {
  69.     $data(ent) configure -validate none
  70.     }
  71.  
  72.     # Dialog boxes should be transient with respect to their parent,
  73.     # so that they will always stay on top of their parent window.  However,
  74.     # some window managers will create the window as withdrawn if the parent
  75.     # window is withdrawn or iconified.  Combined with the grab we put on the
  76.     # window, this can hang the entire application.  Therefore we only make
  77.     # the dialog transient if the parent is viewable.
  78.  
  79.     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  80.     wm transient $w $data(-parent)
  81.     }
  82.  
  83.     trace add variable data(selectPath) write \
  84.         [list ::tk::dialog::file::SetPath $w]
  85.     $data(dirMenuBtn) configure \
  86.         -textvariable ::tk::dialog::file::${dataName}(selectPath)
  87.  
  88.     set data(filter) "*"
  89.     set data(previousEntryText) ""
  90.     ::tk::dialog::file::UpdateWhenIdle $w
  91.  
  92.     # Withdraw the window, then update all the geometry information
  93.     # so we know how big it wants to be, then center the window in the
  94.     # display and de-iconify it.
  95.  
  96.     ::tk::PlaceWindow $w widget $data(-parent)
  97.     wm title $w $data(-title)
  98.  
  99.     # Set a grab and claim the focus too.
  100.  
  101.     ::tk::SetFocusGrab $w $data(ent)
  102.     $data(ent) delete 0 end
  103.     $data(ent) insert 0 $data(selectPath)
  104.     $data(ent) selection range 0 end
  105.     $data(ent) icursor end
  106.  
  107.     # Wait for the user to respond, then restore the focus and
  108.     # return the index of the selected button.  Restore the focus
  109.     # before deleting the window, since otherwise the window manager
  110.     # may take the focus away so we can't redirect it.  Finally,
  111.     # restore any grab that was in effect.
  112.  
  113.     vwait ::tk::Priv(selectFilePath)
  114.  
  115.     ::tk::RestoreFocusGrab $w $data(ent) withdraw
  116.  
  117.     # Cleanup traces on selectPath variable
  118.     #
  119.  
  120.     foreach trace [trace info variable data(selectPath)] {
  121.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  122.     }
  123.     $data(dirMenuBtn) configure -textvariable {}
  124.  
  125.     # Return value to user
  126.     #
  127.     
  128.     return $Priv(selectFilePath)
  129. }
  130.  
  131. # ::tk::dialog::file::chooseDir::Config --
  132. #
  133. #    Configures the Tk choosedir dialog according to the argument list
  134. #
  135. proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
  136.     upvar ::tk::dialog::file::$dataName data
  137.  
  138.     # 0: Delete all variable that were set on data(selectPath) the
  139.     # last time the file dialog is used. The traces may cause troubles
  140.     # if the dialog is now used with a different -parent option.
  141.     #
  142.     foreach trace [trace info variable data(selectPath)] {
  143.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  144.     }
  145.  
  146.     # 1: the configuration specs
  147.     #
  148.     set specs {
  149.     {-mustexist "" "" 0}
  150.     {-initialdir "" "" ""}
  151.     {-parent "" "" "."}
  152.     {-title "" "" ""}
  153.     }
  154.  
  155.     # 2: default values depending on the type of the dialog
  156.     #
  157.     if {![info exists data(selectPath)]} {
  158.     # first time the dialog has been popped up
  159.     set data(selectPath) [pwd]
  160.     }
  161.  
  162.     # 3: parse the arguments
  163.     #
  164.     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  165.  
  166.     if {$data(-title) eq ""} {
  167.     set data(-title) "[mc "Choose Directory"]"
  168.     }
  169.     
  170.     # Stub out the -multiple value for the dialog; it doesn't make sense for
  171.     # choose directory dialogs, but we have to have something there because we
  172.     # share so much code with the file dialogs.
  173.     set data(-multiple) 0
  174.  
  175.     # 4: set the default directory and selection according to the -initial
  176.     #    settings
  177.     #
  178.     if {$data(-initialdir) ne ""} {
  179.     # Ensure that initialdir is an absolute path name.
  180.     if {[file isdirectory $data(-initialdir)]} {
  181.         set old [pwd]
  182.         cd $data(-initialdir)
  183.         set data(selectPath) [pwd]
  184.         cd $old
  185.     } else {
  186.         set data(selectPath) [pwd]
  187.     }
  188.     }
  189.  
  190.     if {![winfo exists $data(-parent)]} {
  191.     error "bad window path name \"$data(-parent)\""
  192.     }
  193. }
  194.  
  195. # Gets called when user presses Return in the "Selection" entry or presses OK.
  196. #
  197. proc ::tk::dialog::file::chooseDir::OkCmd {w} {
  198.     upvar ::tk::dialog::file::[winfo name $w] data
  199.  
  200.     # This is the brains behind selecting non-existant directories.  Here's
  201.     # the flowchart:
  202.     # 1.  If the icon list has a selection, join it with the current dir,
  203.     #     and return that value.
  204.     # 1a.  If the icon list does not have a selection ...
  205.     # 2.  If the entry is empty, do nothing.
  206.     # 3.  If the entry contains an invalid directory, then...
  207.     # 3a.   If the value is the same as last time through here, end dialog.
  208.     # 3b.   If the value is different than last time, save it and return.
  209.     # 4.  If entry contains a valid directory, then...
  210.     # 4a.   If the value is the same as the current directory, end dialog.
  211.     # 4b.   If the value is different from the current directory, change to
  212.     #       that directory.
  213.  
  214.     set selection [tk::IconList_CurSelection $data(icons)]
  215.     if {[llength $selection] != 0} {
  216.     set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]]
  217.     set iconText [file join $data(selectPath) $iconText]
  218.     Done $w $iconText
  219.     } else {
  220.     set text [$data(ent) get]
  221.     if {$text eq ""} {
  222.         return
  223.     }
  224.     set text [file join {*}[file split [string trim $text]]]
  225.     if {![file exists $text] || ![file isdirectory $text]} {
  226.         # Entry contains an invalid directory.  If it's the same as the
  227.         # last time they came through here, reset the saved value and end
  228.         # the dialog.  Otherwise, save the value (so we can do this test
  229.         # next time).
  230.         if {$text eq $data(previousEntryText)} {
  231.         set data(previousEntryText) ""
  232.         Done $w $text
  233.         } else {
  234.         set data(previousEntryText) $text
  235.         }
  236.     } else {
  237.         # Entry contains a valid directory.  If it is the same as the
  238.         # current directory, end the dialog.  Otherwise, change to that
  239.         # directory.
  240.         if {$text eq $data(selectPath)} {
  241.         Done $w $text
  242.         } else {
  243.         set data(selectPath) $text
  244.         }
  245.     }
  246.     }
  247.     return
  248. }
  249.  
  250. # Change state of OK button to match -mustexist correctness of entry
  251. #
  252. proc ::tk::dialog::file::chooseDir::IsOK? {w text} {
  253.     upvar ::tk::dialog::file::[winfo name $w] data
  254.  
  255.     set ok [file isdirectory $text]
  256.     $data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}]
  257.  
  258.     # always return 1
  259.     return 1
  260. }
  261.  
  262. proc ::tk::dialog::file::chooseDir::DblClick {w} {
  263.     upvar ::tk::dialog::file::[winfo name $w] data
  264.     set selection [tk::IconList_CurSelection $data(icons)]
  265.     if {[llength $selection] != 0} {
  266.     set filenameFragment \
  267.         [tk::IconList_Get $data(icons) [lindex $selection 0]]
  268.     set file $data(selectPath)
  269.     if {[file isdirectory $file]} {
  270.         ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
  271.         return
  272.     }
  273.     }
  274. }
  275.  
  276. # Gets called when user browses the IconList widget (dragging mouse, arrow
  277. # keys, etc)
  278. #
  279. proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
  280.     upvar ::tk::dialog::file::[winfo name $w] data
  281.  
  282.     if {$text eq ""} {
  283.     return
  284.     }
  285.  
  286.     set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
  287.     $data(ent) delete 0 end
  288.     $data(ent) insert 0 $file
  289. }
  290.  
  291. # ::tk::dialog::file::chooseDir::Done --
  292. #
  293. #    Gets called when user has input a valid filename.  Pops up a
  294. #    dialog box to confirm selection when necessary. Sets the
  295. #    Priv(selectFilePath) variable, which will break the "vwait"
  296. #    loop in tk_chooseDirectory and return the selected filename to the
  297. #    script that calls tk_getOpenFile or tk_getSaveFile
  298. #
  299. proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
  300.     upvar ::tk::dialog::file::[winfo name $w] data
  301.     variable ::tk::Priv
  302.  
  303.     if {$selectFilePath eq ""} {
  304.     set selectFilePath $data(selectPath)
  305.     }
  306.     if {$data(-mustexist) && ![file isdirectory $selectFilePath]} {
  307.     return
  308.     }
  309.     set Priv(selectFilePath) $selectFilePath
  310. }
  311.